Delphi 2.0 - Programmer's Utilities Power Pack/Delphi 2.0 Programmer's Utilities Power Pack.iso/a_to_d/ansmach/ansmach1.pas

Pascal/Delphi Source File | 1996-09-15 | 15.3 KB | 514 lines

unit Ansmach1;

{=============================================================================}
interface

{=============================================================================}
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls, Menus, DLGTIF, AnsMach2;

{=============================================================================}
const
  DLG_EVENT = WM_USER + 1;         { unique message for line events }

  MSG_GREETING   = 'ansmach0.vox';  { greeting file }
  MSG_MESSAGES   = 'ansmach1.vox';  { callers recorded messages }
  MSG_OPTIONMENU = 'ansmach2.vox';  { remote access option menu }
  MSG_FORWARDING = 'ansmach3.vox';  { call forwarding alert prompt }

  PIN = '123#';                     { remote access password }

  DETECTLOOP = 0;                   { loop-drop detection }

{=============================================================================}
type
  lineState = ( sIdle,            { waiting fo call }
                sAnswer,          { going off-hook (answer) }
                sPlayGreeting,    { playing greeting message }
                sRecordMessage,   { recording callers message }
                sGetPIN,          { getting remote access PIN }
                sOptionMenu,      { playing remote access option menu }
                sGetOption,       { getting option menu choice }
                sPlayMessages,    { playback recorded messages }
                sRecordGreeting,  { re-record greeting }
                sGetForwarding,   { getting new forwarding phone number }
                sGetMaxMsgCount,  { getting }
                sCallForwarding,  { calling forwarding number }
                sPlayForwarding,  { playing forward message alert }
                sHangUp,          { going on-hook (hanging up) }
                sSettleLine       { settling line (2 second delay) }
              );

{=============================================================================}
type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Label1: TLabel;
    Label2: TLabel;
    txtForward: TEdit;
    txtMaxMsg: TEdit;
    Label3: TLabel;
    txtMsgCount: TEdit;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    mnAbout: TMenuItem;
    N2: TMenuItem;
    Exit1: TMenuItem;

    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure mnAboutClick(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);

  private
    { Private declarations }

  public
    { Public declarations }

  protected
    lineNo,                    { active channel }
    hFile: word;               { global file handle }

    msgForwarded: boolean;     { messages forwarded flag }

    currentState: lineState;   { current state of line }

    tmpBuf: pchar;             { tmp string buf }

    procedure msgProc( var msg: TMessage ); message DLG_EVENT;
    procedure processEvent( lineNo: word );
    procedure changeState( lineNo: word; newState: lineState );
    procedure trace( s: string );
  end;

{=============================================================================}
var
  Form1: TForm1;

  errNo,                     { global return error }
  hMem: word;                { memory handle }

  digitBuf: pChar;           { global DTMF digit buffer }

  realPtr: longint;          { pointer to real memory address }

{=============================================================================}
implementation

{$R *.DFM}

{==============================================================================}
function atoi( chr: char ): integer;
begin
  case chr of
    '0'..'9':
      atoi := ord( chr ) - ord( '0' );

    else
      atoi := 0;
  end;
end;

{==============================================================================}
procedure ReplaceChar( s: pchar; oldChar: char; newChar: char );
var
  p: pchar;

begin
  p := StrScan( s, oldChar );

  if ( p <> nil ) then
    p^ := newChar;
end;

{==============================================================================}
procedure resetFile( fileName: pchar );
begin
  DskFilCls( DskFilCre( fileName, OF_WRITE, errNo ), errNo );
end;

{==============================================================================}
function playFile( lineNo: word; voxFile: pchar; var hFile: word ): word;
var
  rwblk: RWB;

begin
  clrdtmf( lineNo );  { clear the DTMF buffer for the line }
  clrrwb( rwblk );    { reset RWB to assure defaults }

  hFile := DskFilOpn( voxFile, OF_READ, errNo );  { open file }

  rwblk.filehndl := hFile;       { handle of file to play from }
  rwblk.loopsig  := detectLoop;  { terminate if drop in loop-current }
  rwblk.termdtmf := ord('@');    { terminate on any digit }

  playFile := xplayf( lineNo, PM_NORM, rwblk );  { begin playing }
end;

{==============================================================================}
function recordFile( lineNo: word; voxFile: pchar; var hFile: word; append: boolean ): word;
var
  rwblk: RWB;

begin
  clrdtmf( lineNo );  { clear the DTMF buffer for the line }
  clrrwb( rwblk );     { reset RWB to assure defaults }

  hFile := DskFilOpn( voxFile, OF_WRITE or OF_CREATE, errNo );  { open file }

  rwblk.filehndl := hFile;       { handle of file to record to }
  rwblk.loopsig  := detectLoop;  { terminate if drop in loop-current }
  rwblk.termdtmf := ord('#');    { terminate on '#' digit }
  rwblk.rwbflags := RW_TONE;     { begin recording with tone }
  rwblk.rwbdata1 := 3;           { duration of recording tone }

  if ( append ) then             { begin record at EOF?... }
    DskFilPos( rwblk.filehndl, 0, SEEK_END, errNo );  { seek to EOF }

  recordFile := recfile( lineNo, rwblk, RM_NORM );  { begin recording }
end;

{==============================================================================}
function getDigits( lineNo, maxDigits, maxSec: word; flushDigits: boolean ): word;
var
  rwblk: RWB;

begin
  clrrwb( rwblk );  { reset RWB to assure defaults }

  if ( flushDigits ) then
    clrdtmf( lineNo );

  digitBuf[0] := #0;

  rwblk.xferseg  := HiWord( realPtr );  { get segment of digit buffer }
  rwblk.xferoff  := LoWord( realPtr );  { get offset of digit buffer }
  rwblk.loopsig  := detectLoop;         { terminate on drop in loop-current }
  rwblk.termdtmf := ord('#');           { terminate on '#' digit }
  rwblk.maxdtmf  := maxDigits;          { max number of digit(s) to accept }
  rwblk.maxsec   := maxSec;             { max seconds to wait for digit(s) }

  getDigits := getdtmfs( lineNo, rwblk );  { get digit(s) }
end;

{=============================================================================}
procedure TForm1.FormCreate(Sender: TObject);
var
  lineCount: word;  { total channels }

begin
  hFile        := 0;
  msgForwarded := False;
  tmpBuf       := StrAlloc( 128 );

  errNo := TIFSupIni( 0, 0, 0 );

  if ( errNo > 0 ) then
    ShowMessage( 'D4x driver not loaded!' );

  errNo := startsys( 0, 0, 0, lineCount );

  if ( errNo = E_SUCC ) then
    trace( 'lineCount=' + IntToStr( lineCount ) )
  else
    ShowMessage( 'Unable to initialize driver.' + IntToStr( errNo ) );

  lineNo := TIFLinGet( 1, CALLBACK_WINDOW, MakeLong( Handle, DLG_EVENT ) );

  if ( lineNo = 0 ) then
    ShowMessage( 'Unable to allocate line 1' );

  digitBuf := MemGetRea( realPtr, hMem, 128 );

  setcst( lineNo, C_RING or C_OFFH or C_ONH, 1 );
  resetFile( MSG_MESSAGES );
  changeState( lineNo, sIdle );
end;

{=============================================================================}
procedure TForm1.FormDestroy(Sender: TObject);
begin
  StrDispose( tmpBuf );
  MemRelRea( hMem );

  errNo := TIFLinRel( lineNo, 0, 0 );
  errNo := StopSys;
  errNo := TIFSuptrm;
end;

{=============================================================================}
procedure TForm1.FormShow(Sender: TObject);
begin
  mnAboutClick( Sender );
end;

{=============================================================================}
procedure TForm1.mnAboutClick(Sender: TObject);
begin
  AboutBox.ShowModal;
end;

{=============================================================================}
procedure TForm1.Exit1Click(Sender: TObject);
begin
  Close;
end;

{=============================================================================}
procedure TForm1.msgProc( var msg: TMessage );
var
  evtCode,
  evtData,
  lineNo:  word;

begin
  evtCode := msg.WParam;
  evtData := LoWord( msg.LParam );
  lineNo  := HiWord( msg.LParam );

  trace( '[' + IntToStr( lineNo ) + '] evtCode=' + IntToStr( evtCode ) + ' (' + intToStr( evtData ) + ')' );

  processEvent( lineNo );
end;

{==============================================================================}
procedure TForm1.processEvent( lineNo: word );
var
  evtCode,
  evtData: word;

  evtBlk: TIFEVTBLK;

  nextState: lineState;

begin
  nextState := sHangup;  { next default state }

  if ( hFile > 0 ) then     { was a file opened?... }
    begin
      DskFilCls( hFile, errNo );  { close file }

      hFile := 0;
    end;

  evtCode := GetLinEvt( lineNo, evtData, evtBlk );  { get event on line }

  case currentState of
    sIdle:  { waiting for call }
      case evtCode of
        T_RING:  { only respond to ringing }
          nextState := sAnswer;
      end;

    sAnswer:  { answer line }
      case evtCode of
        T_OFFH:
          nextState := sPlayGreeting;
      end;

    sHangUp:  { hang up line }
      nextState := sSettleLine;

    sSettleLine:  { settle line between calls }
      if ( msgForwarded = True ) or
         ( StrToInt( txtMaxMsg.Text ) = 0 ) or
         ( txtMsgCount.Text < txtMaxMsg.Text ) then
        nextState := sIdle
      else
        nextState := sCallForwarding;

    sPlayGreeting:  { play greeting }
      case evtCode of
        T_EOF:
          nextState := sRecordMessage;

        T_TERMDT:
          nextState := sGetPIN;
      end;

    sRecordMessage:  { record callers message }
      begin
        msgForwarded     := False;
        txtMsgCount.Text := IntToStr( StrToInt( txtMsgCount.Text ) + 1 );
        nextState        := sHangUp;
      end;

    sGetPIN:  { get remote access PIN and verify }
      case evtCode of
        T_TERMDT:
          if ( StrComp( digitBuf, PIN ) = 0 ) then
            begin
              msgForwarded := TRUE;
              nextState    := sOptionMenu;
            end;
      end;

    sOptionMenu:  { play remote access menu }
      case evtCode of
        T_EOF, T_TERMDT:
          nextState := sGetOption;
      end;

    sGetOption:  { get menu choice }
      case evtCode of
        T_MAXDT:
          case digitBuf[0] of
            '1':  { play messages }
              nextState := sPlayMessages;

            '2': { erase messages }
              begin
                resetFile( MSG_MESSAGES );

                txtMsgCount.Text := '0';
                nextState        := sOptionMenu;
              end;

            '3': { re-record greeting }
              nextState := sRecordGreeting;

            '4': { change forwarding number }
              nextState := sGetForwarding;

            '5': { change forwarding number }
              nextState := sGetMaxMsgCount;

            '*': { end call }
              nextState := sHangUp;
          end;
      end;

    sPlayMessages:  { play recorded messages }
      case evtCode of
        T_EOF, T_TERMDT:
          nextState := sOptionMenu;  { continue with remote access menu }
      end;

    sRecordGreeting:  { re-record greeting }
      case evtCode of
        T_TERMDT:
          nextState := sOptionMenu;  { continue with remote access menu }
      end;

    sGetForwarding:  { change call forwarding number }
      case evtCode of
        T_TERMDT:
          begin
            ReplaceChar( digitBuf, '*', ',' );     { replace '*' with ',' }
            ReplaceChar( digitBuf, '#', #0 );      { replace '#' with #0 }

            txtForward.SetTextBuf( digitBuf );     { save new forwarding number }

            nextState := sOptionMenu;              {continue with remote access menu }
          end;
      end;

    sGetMaxMsgCount:  { change max message count }
      case evtCode of
        T_MAXDT:
          begin
            txtMaxMsg.SetTextBuf( digitBuf );    { save new max message count }

            nextState := sOptionMenu;            { continue with remote access menu }
          end;
      end;

    sCallForwarding:  { call forwarding number }
      { continue with alert message if forwarding number was answered }
      case evtCode of
        T_CATERM:
          if ( evtData = CA_CONN ) then
            nextState := sPlayForwarding;
      end;

    sPlayForwarding:  { play forwarding alert message }
      { after alert message, get remote access PIN }
      case evtCode of
        T_EOF, T_TERMDT:
          nextState := sGetPIN;
      end;
  end;

  changeState( lineNo, nextState );
end;

{==============================================================================}
procedure TForm1.changeState( lineNo: word; newState: lineState );
var
  buf: string;

begin
  case newState of
    sIdle:  { waiting for call }
      errNo := 0;

    sAnswer:  { answer phone }
      errNo := sethook( lineNo, H_OFFH );

    sHangUp:  { hang up phone }
      errNo := sethook( lineNo, H_ONH );

    sSettleLine:  { settle line }
      {  NOTE:
           This state is required to assure that the call is properly terminated.
           The goal is to let the line 'settle' for two seconds.  To do this the
           line is tricked to wait for digits even though the line is ON-hook.
           The line will eventuly time-out because no digits were entered. }

      errNo := getDigits( lineNo, 1 , 2, TRUE );

    sPlayGreeting:  { play greeting message }
      errNo := playFile( lineNo, MSG_GREETING, hFile );

    sRecordMessage:  { record callers messages }
      errNo := recordFile( lineNo, MSG_MESSAGES, hFile, TRUE );

    sGetPIN:  { get remote access PIN }
      errNo := getDigits( lineNo, 10, 15, FALSE );

    sOptionMenu:  { play remote access options }
      errNo := playFile( lineNo, MSG_OPTIONMENU, hFile );

    sGetOption:  { get menu option digit }
      errNo := getDigits( lineNo, 1, 15, FALSE );

    sPlayMessages:  { play-back recorded messages }
      errNo := playFile( lineNo, MSG_MESSAGES, hFile );

    sRecordGreeting:  { re-record greeting }
      errNo := recordFile( lineNo, MSG_GREETING, hFile, FALSE );

    sGetForwarding:  { get net forwarding number }
      errNo := getDigits( lineNo, 15, 15, FALSE );

    sGetMaxMsgCount:  { get new max message count }
      errNo := getDigits( lineNo, 1, 15, FALSE );

    sCallForwarding:  { call forwarding number }
      begin
        txtForward.GetTextBuf( tmpBuf, 128 );

        errNo := callp( lineNo, tmpBuf );
      end;

    sPlayForwarding:  { play forwarding alert message }
      errNo := playFile( lineNo, MSG_FORWARDING, hFile );
  end;

  if ( errNo = 0 ) then
    currentState := newState
  else
    ShowMessage( 'Dialogic error #' + IntToStr( errNo ) );
end;

{=============================================================================}
procedure TForm1.trace( s: string );
begin
  ListBox1.Items.Add( s );
end;

end.